home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
LOGIC Apps
/
Logic-APPLE_II_APPS.iso
/
mac
/
LOGIC Apple II 5.25" Library - ProDOS
/
PRO018.dsk
/
STARLANES.bas
< prev
next >
Wrap
BASIC Source File
|
2012-02-16
|
14KB
|
277 lines
100 TEXT : NORMAL : HOME : SPEED= 255
110 FOR I = 7 TO 0 STEP -1: VTAB 11 -I: HTAB 12 -I: PRINT "S T A R": VTAB 11 +I: HTAB 20 +I: PRINT "L A N E S"
120 IF I THEN FOR J = 1 TO 70: NEXT : HOME
130 NEXT : VTAB 20: PRINT "A GAME OF INTERSTELLAR SHIPPING FOR 2-4."
140 PRINT "DO YOU WANT TO SEE THE RULES? ";: GET Z$: PRINT Z$: IF Z$ = "Y" OR Z$ = "y" THEN GOSUB 2030
150 DATA ALTAIR STARWAYS,BETELGEUSE BRIDGE,CAPELLA FREIGHT,DENEBOLA SHIPPERS,ERIDANI EXPRESS
160 CO = 5: DIM M$(CO),M(10,13),S(CO,4),D1(CO),S1(CO),Q(CO),B(4),N$(4),P$(4),R(5),C(5)
170 FOR I = 1 TO CO: READ M$(I):S1(I) = 100: NEXT
180 DEF FN R(Z) = 1 + INT(Z * RND(1))
190 FOR I = 1 TO 9: FOR J = 1 TO 12:M(I,J) = 1 +2 *( RND(1) >.9): NEXT : NEXT
200 L$ = ".+*ABCDE":M$ = "ABCDEFGHIJKL"
210 HOME : PRINT "HOW MANY PLAYERS? (2-4): ";
220 GET Z$:P1 = VAL(Z$): IF P1 >1 AND P1 <5 THEN PRINT P1: PRINT : GOTO 250
230 IF Z$ = "0" THEN HOME : END
240 PRINT CHR$(7);: GOTO 220
250 PRINT
260 FOR I = 1 TO P1: PRINT : PRINT "NAME OF PLAYER #"I;: INPUT ": ";P$(I): NEXT
270 PRINT : PRINT : PRINT "ORDER OF PLAY: ": PRINT
280 FOR I = 1 TO 20:J = FN R(P1):K = FN R(P1):Z$ = P$(J):P$(J) = P$(K):P$(K) = Z$: NEXT
290 FOR I = 1 TO P1: PRINT I" ... "P$(I):B(I) = 6000: NEXT
300 IF K = 48 GOTO 1940
310 K = K +1:P = P +1: IF P >P1 THEN P = 1
320 FOR I = 1 TO 5
330 R = FN R(9):C = FN R(12): IF M(R,C) >1 GOTO 330
340 IF I >1 THEN FOR J = 1 TO I -1: ON (R = R(J)) *(C = C(J)) GOTO 330: NEXT
350 Z = 0: FOR J = 1 TO CO:Z = Z + SGN(Q(J)): NEXT : IF Z <5 GOTO 410
360 ZN = M(R -1,C): IF ZN >3 GOTO 410
370 ZE = M(R,C +1): IF ZE >3 GOTO 410
380 ZS = M(R +1,C): IF ZS >3 GOTO 410
390 ZW = M(R,C -1): IF ZW >3 GOTO 410
400 IF ZN >1 OR ZE >1 OR ZS >1 OR ZW >1 GOTO 330
410 R(I) = R:C(I) = C: NEXT
420 GOSUB 1180
430 FLASH : FOR I = 1 TO 5:R = R(I):C = C(I): VTAB R +R +1: HTAB C +C +C +1: PRINT ".";: NEXT : NORMAL
440 E$ = ""
450 HOME : FOR I = 1 TO 5: VTAB 19 +I: HTAB 30: PRINT CHR$(64 +I) RIGHT$("......." + STR$(S(I,P)),8);
460 NEXT : VTAB 20: HTAB 1: PRINT E$: PRINT P$(P)",":R = 0:C = 0
470 PRINT "ENTER YOUR MOVE: ";
480 GET R$: IF R$ = CHR$(8) OR R$ = CHR$(127) GOTO 440
490 E$ = "TYPE A LETTER AND A NUMBER."
500 IF R = 0 THEN IF R$ >"0" AND R$ < = "9" THEN R = VAL(R$): GOTO 540
510 IF R$ = >"a" AND R$ < = "z" THEN R$ = CHR$( ASC(R$) -32)
520 IF C = 0 THEN IF R$ = >"A" AND R$ < = "L" THEN C = ASC(R$) -64: GOTO 540
530 GOTO 450
540 PRINT R$;: IF R *C = 0 GOTO 480
550 FOR I = 1 TO 5: IF R = R(I) AND C = C(I) THEN I = 5: NEXT : GOTO 570
560 NEXT :E$ = "SELECT A FLASHING SECTOR": GOTO 450
570 TEXT : HOME
580 A1 = M(R -1,C):A2 = M(R +1,C):A3 = M(R,C +1):A4 = M(R,C -1)
590 IF A1 < = 1 AND A2 < = 1 AND A3 < = 1 AND A4 < = 1 THEN M(R,C) = 2: GOTO 890
600 IF A1 >1 AND A2 >3 AND A2 < >A1 THEN GOSUB 1240
610 IF A1 >3 AND A3 >3 AND A3 < >A1 THEN GOSUB 1240
620 IF A1 >3 AND A4 >3 AND A4 < >A1 THEN GOSUB 1240
630 IF A2 >3 AND A3 >3 AND A3 < >A2 THEN GOSUB 1240
640 IF A2 >3 AND A4 >3 AND A4 < >A2 THEN GOSUB 1240
650 IF A3 >3 AND A4 >3 AND A4 < >A3 THEN GOSUB 1240
660 IF A1 <4 AND A2 <4 AND A3 <4 AND A4 <4 THEN 730
670 IF M(R,C) >3 THEN 890
680 IF A1 >3 THEN I = A1 -3
690 IF A2 >3 THEN I = A2 -3
700 IF A3 >3 THEN I = A3 -3
710 IF A4 >3 THEN I = A4 -3
720 Q(I) = Q(I) +1:S1(I) = S1(I) +100:M(R,C) = I +3: GOTO 790
730 FOR I = 1 TO 5: IF Q(I) = 0 THEN 750
740 NEXT I: IF M(R,C) <3 THEN M(R,C) = 2: GOTO 890
750 GOSUB 1810: PRINT "A NEW SHIPPING COMPANY HAS BEEN FORMED!"
760 PRINT "ITS NAME IS ";M$(I):S(I,P) = S(I,P) +5:Q(I) = 1
770 PRINT : PRINT : PRINT : PRINT : PRINT
780 FOR DE = 1 TO 600: NEXT DE
790 IF A1 = 3 THEN S1(I) = S1(I) +500
800 IF A2 = 3 THEN S1(I) = S1(I) +500
810 IF A3 = 3 THEN S1(I) = S1(I) +500
820 IF A4 = 3 THEN S1(I) = S1(I) +500
830 IF A1 = 2 THEN S1(I) = S1(I) +100:Q(I) = Q(I) +1:M(R -1,C) = I +3
840 IF A2 = 2 THEN S1(I) = S1(I) +100:Q(I) = Q(I) +1:M(R +1,C) = I +3
850 IF A3 = 2 THEN S1(I) = S1(I) +100:Q(I) = Q(I) +1:M(R,C +1) = I +3
860 IF A4 = 2 THEN S1(I) = S1(I) +100:Q(I) = Q(I) +1:M(R,C -1) = I +3
870 IF S1(I) > = 3000 THEN T1 = I: GOSUB 1700
880 M(R,C) = I +3
890 FOR I = 1 TO 5:B(P) = B(P) + INT(.05 *S(I,P) *S1(I)): NEXT I
900 TEXT : HOME :Z$ = P$(P) +"'S HOLDINGS":Z = LEN(Z$) <20
910 PRINT SPC( 4): FOR I = 1 TO LEN(Z$)
920 PRINT MID$ (Z$,I,1) SPC( Z): NEXT : PRINT
930 INVERSE : PRINT " COMPANY PRICE # VALUE "
940 PRINT " NAME: / SHARE OWNED ": NORMAL : PRINT : PRINT
950 ZN = 0:ZW = 0: FOR I = 1 TO 5:N = S(I,P): IF Q(I) = 0 GOTO 1010
960 S = S1(I):ZN = ZN +N:W = N *S:ZW = ZW +W
970 PRINT LEFT$(M$(I),21);
980 Z$ = STR$(S): PRINT TAB( 26 - LEN(Z$))Z$;
990 Z$ = STR$(N): PRINT TAB( 31 - LEN(Z$))Z$;
1000 Z$ = STR$(W): PRINT TAB( 40 - LEN(Z$))Z$
1010 NEXT : IF ZN = 0 GOTO 1050
1020 PRINT : PRINT " T O T A L : ";
1030 Z$ = STR$(ZN): PRINT TAB( 31 - LEN(Z$))Z$;
1040 Z$ = STR$(ZW): PRINT TAB( 40 - LEN(Z$))Z$
1050 Z$ = STR$(B(P)): PRINT : PRINT " CASH ON HAND:" TAB( 40 - LEN(Z$))Z$
1060 POKE 34,16: HOME : PRINT "SELECT A SECURITY BY LETTER,": PRINT "OR PRESS RETURN TO RESUME THE GAME. ";
1070 GET Z$: IF Z$ = "" GOTO 1070
1080 Z = ASC(Z$) -64: IF Z >32 THEN Z = Z -32
1090 IF Z >0 AND Z <6 THEN IF Q(Z) GOTO 1110
1100 PRINT : TEXT : VTAB 16: GOTO 1170
1110 PRINT Z$: HOME : PRINT M$(Z)" IS TRADING AT $"S1(Z)
1120 ZM = 0: IF B(P) THEN ZM = INT(B(P)/S1(Z)): IF ZM >20 THEN ZM = INT(ZM/2)
1130 IF ZM = 0 THEN PRINT "YOU CANNOT AFFORD ANY OF THAT STOCK.": GOTO 1170
1140 PRINT "HOW MANY SHARES (0-9) (*="ZM"): ";
1150 GET Z$:N = VAL(Z$): IF N >ZM OR Z$ = "*" THEN N = ZM
1160 PRINT N:B(P) = B(P) -N *S1(Z):S(Z,P) = S(Z,P) +N
1170 TEXT : GOTO 300
1180 TEXT : HOME : PRINT " M A P O F T H E G A L A X Y"
1190 INVERSE : PRINT " A B C D E F G H I J K L "
1200 FOR R = 1 TO 9: VTAB R +R +1: PRINT R;: HTAB 40: PRINT R;: IF R <9 THEN PRINT " ";: HTAB 40: PRINT " "
1210 NEXT : NORMAL
1220 FOR R = 1 TO 9: VTAB R +R +1: FOR C = 1 TO 12: HTAB C +C +C +1: PRINT MID$ (L$,M(R,C),1);: NEXT : NEXT
1230 POKE 34,19: RETURN
1240 F1 = A1 -3: IF F1 <0 THEN F1 = 0
1250 F2 = A2 -3: IF F2 <0 THEN F2 = 0
1260 F3 = A3 -3: IF F3 <0 THEN F3 = 0
1270 F4 = A4 -3: IF F4 <0 THEN F4 = 0
1280 T = Q(F1):T1 = F1: IF Q(F2) >Q(F1) THEN T = Q(F2):T1 = F2
1290 IF Q(F3) >T THEN T = Q(F3):T1 = F3
1300 IF Q(F4) >T THEN T = Q(F4):T1 = F4
1310 IF F1 = T1 OR A1 <4 THEN 1330
1320 X = F1: GOSUB 1400
1330 IF F2 = T1 OR A2 <4 THEN 1350
1340 X = F2: GOSUB 1400
1350 IF F3 = T1 OR A3 <4 THEN 1370
1360 X = F3: GOSUB 1400
1370 IF F4 = T1 OR A4 <4 THEN 1390
1380 X = F4: GOSUB 1400
1390 RETURN
1400 GOSUB 1810: PRINT M$(X)" HAS JUST BEEN MERGED": PRINT "INTO ";
1410 PRINT M$(T1)"!": PRINT "PLEASE NOTE THE FOLLOWING TRANSACTIONS:"
1420 PRINT : HTAB (4): PRINT "OLD STOCK = "M$(X): HTAB (4): PRINT "NEW STOCK = ";
1430 PRINT M$(T1): PRINT
1440 PRINT "PLAYER OLD NEW TOTAL BONUS PAID"
1450 PRINT "----------------------------------------"
1460 FOR I = 1 TO P1: PRINT P$(I);: HTAB (10): PRINT S(X,I);: HTAB (15): PRINT INT((.5 *S(X,I)) +.5);
1470 HTAB (20): PRINT S(T1,I) + INT((.5 *S(X,I)) +.5);
1480 X1 = 0: FOR I1 = 1 TO P1:X1 = X1 +S(X,I1): NEXT I1
1490 HTAB (30)
1500 IF X1 = 0 THEN PRINT " $ 0": GOTO 1520
1510 PRINT " $" INT(10 *((S(X,I)/X1) *S1(X)))
1520 NEXT I
1530 PRINT "----------------------------------------"
1540 FOR I = 1 TO P1:S(T1,I) = S(T1,I) + INT((.5 *S(X,I)) +.5)
1550 IF X1 = 0 GOTO 1570
1560 B(I) = B(I) + INT(10 *((S(X,I)/X1) *S1(X)))
1570 NEXT I
1580 FOR I = 1 TO 9: FOR J = 1 TO 12: IF M(I,J) = X +3 THEN M(I,J) = T1 +3
1590 NEXT J: NEXT I
1600 A1 = M(R -1,C):A2 = M(R +1,C):A3 = M(R,C +1):A4 = M(R,C -1)
1610 F1 = A1 -3: IF F1 <0 THEN F1 = 0
1620 F2 = A2 -3: IF F2 <0 THEN F2 = 0
1630 Q(T1) = Q(T1) +Q(X):S1(T1) = S1(T1) +S1(X): IF S1(T1) >3000 THEN GOSUB 1700
1640 F3 = A3 -3: IF F3 <0 THEN F3 = 0
1650 F4 = A4 -3: IF F4 <0 THEN F4 = 0
1660 S1(X) = 100:Q(X) = 0: FOR I = 1 TO P1:S(X,I) = 0: NEXT I
1670 PRINT
1680 M(R,C) = T1 +3
1690 RETURN
1700 GOSUB 1810: PRINT "THE STOCK OF ";
1710 PRINT M$(T1)" HAS SPLIT 2 FOR 1!":S1(T1) = INT(S1(T1)/2)
1720 PRINT : PRINT
1730 FOR I1 = 1 TO P1:S(T1,I1) = 2 *S(T1,I1): NEXT I1
1740 RETURN
1750 HOME : VTAB 6
1760 HTAB 5: PRINT "STOCK";: HTAB (17): PRINT "PRICE/SHR";: HTAB (28): PRINT "YOUR HOLDINGS"
1770 PRINT "----------------------------------------"
1780 FOR I3 = 1 TO 5: IF S1(I3) = 100 THEN 1800
1790 PRINT M$(I3);: HTAB (20): PRINT ;S1(I3);: HTAB (33): PRINT ;S(I3,P)
1800 NEXT I3: PRINT "----------------------------------------": PRINT : PRINT : PRINT : RETURN
1810 PRINT : PRINT : PRINT
1820 HTAB (11): PRINT "<CTRL-G>SP<CTRL-G>EC<CTRL-G>IA<CTRL-G>L <CTRL-G>NO<CTRL-G>TI<CTRL-G>CE<CTRL-G>:": PRINT
1830 RETURN
1840 DD$ = "<CTRL-D>": PRINT DD$;"NOMON C": HOME :FF$ = "STARLANES.DOC": PRINT DD$;"OPEN ";FF$
1850 INPUT "SPEED (1-255)? ";SS: SPEED= SS: HOME
1860 PRINT DD$;"READ ";FF$
1870 GET AA$: PRINT AA$;
1880 IF ASC(AA$) = 13 THEN LL = LL +1: PRINT : GOTO 1900
1890 GOTO 1870
1900 IF LL = 108 THEN PRINT DD$;"CLOSE ";FF$: PRINT DD$;"MON C": GOSUB 1930: SPEED= 255: RETURN
1910 IF LL/11 = INT(LL/11) THEN GOSUB 1930: GOTO 1860
1920 GOTO 1870
1930 PRINT DD$: INPUT "HIT RETURN TO CONTINUE ";SS$: HOME : RETURN
1940 GOSUB 1810: PRINT : PRINT " THE GAME IS OVER------": PRINT "HERE ARE THE FINAL STANDINGS:"
1950 PRINT
1960 PRINT "PLAYER STOCK VALUE TOTAL CASH NET WORTH"
1970 PRINT "------ ----------- ---------- ---------"
1980 FOR I = 1 TO P1: FOR J = 1 TO 5:D1(I) = D1(I) +(S1(J) *S(J,I)): NEXT J: NEXT I
1990 FOR I = 1 TO P1: PRINT LEFT$(P$(I),6);: HTAB (10): PRINT "$"D1(I);: HTAB (21): PRINT "$"B(I);
2000 HTAB (32): PRINT "$"D1(I) +B(I): NEXT I
2010 PRINT "----------------------------------------"
2020 POKE 49168,0: GET K$: PRINT CHR$(4)"-STARTUP": END
2030 HOME : PRINT "STAR LANES IS A GAME OF INTERSTELLAR"
2040 PRINT
2050 PRINT "TRADING. THE OBJECT OF THE GAME IS TO"
2060 PRINT
2070 PRINT "AMASS THE GREATEST AMOUNT OF MONEY."
2080 PRINT
2090 PRINT "THIS IS ACCOMPLISHED BY ESTABLISHING"
2100 PRINT
2110 PRINT "VAST,INTERSTELLAR SHIPPING LANES, AND"
2120 PRINT
2130 PRINT "PURCHASING STOCK IN THE COMPANIES THAT"
2140 PRINT
2150 PRINT "CONTROL THOSE TRADE ROUTES. DURING THE"
2160 PRINT
2170 PRINT "COURSE OF THE GAME, STOCK APPRECIATES"
2180 PRINT
2190 PRINT "IN VALUE AS THE SHIPPING COMPANIES": PRINT
2200 PRINT "BECOME LARGER."
2210 GOSUB 2860
2220 PRINT "ALSO, SMALLER COMPANIES CAN BE MERGED"
2230 PRINT
2240 PRINT "INTO LARGER ONES, AND STOCK IN THE": PRINT
2250 PRINT "SMALLER FIRM IS CONVERTED INTO STOCK IN": PRINT
2260 PRINT "THE LARGER ONE AS DESCRIBED BELOW."
2270 PRINT
2280 PRINT " EACH TURN, THE COMPUTER WILL PRESENT": PRINT
2290 PRINT "THE PLAYER WITH FIVE PROSPECTIVE SPACES": PRINT
2300 PRINT "TO OCCUPY ON A 9 BY 12 MATRIX (ROWS 1-9": PRINT
2310 PRINT "COLUMNS A-L). THE PLAYER, AFTER": PRINT
2320 PRINT "EXAMINING THE MAP OF THE GALAXY TO": PRINT
2330 PRINT "DECIDE WHICH SPACE HE WISHES TO OCCUPY": PRINT
2340 PRINT "RESPONDS WITH THE ROW AND COLUMN OF THAT"
2350 GOSUB 2860
2360 PRINT "SPACE, I.E., 7E,8A,ETC. THERE ARE FOUR": PRINT
2370 PRINT "POSSIBLE MOVES A PLAYER CAN MAKE."
2380 PRINT
2390 PRINT "1. HE CAN ESTABLISH AN UNATTACHED"
2400 PRINT
2410 PRINT "OUTPOST- IF HE SELECTS A SPACE THAT IS": PRINT
2420 PRINT "NOT ADJACENT TO A STAR, ANOTHER"
2430 PRINT
2440 PRINT "UNATTACHED OUTPOST, OR AN EXISTING": PRINT
2450 PRINT "SHIPPING LANE, THIS SPACE WILL BE": PRINT
2460 PRINT "DESIGNATED WITH A '+'. HE WILL THEN": PRINT
2470 PRINT "PROCEED WITH STOCK TRANSACTIONS, AS": PRINT
2480 PRINT "LISTED BELOW.": PRINT
2490 PRINT "2. HE CAN ADD TO AN EXISTING LANE"
2500 GOSUB 2860: PRINT
2510 PRINT "IF HE SELECTS A SPACE WHICH IS ADJACENT"
2520 PRINT
2530 PRINT "TO ONE - AND ONLY ONE EXISTING SHIPPING": PRINT
2540 PRINT "LANE, THE SPACE HE SELECTS WILL BE": PRINT
2550 PRINT "ADDED TO THAT SHIPPING LANE, AND WILL": PRINT
2560 PRINT "BE DESIGNATED WITH THE FIRST LETTER OF": PRINT
2570 PRINT "THE COMPANY THAT OWNS THAT LANE. IF": PRINT
2580 PRINT "THERE ARE ANY STARS OR UNATTACHED": PRINT
2590 PRINT "UNATTACHED OUTPOSTS ALSO ADJACENT TO": PRINT
2600 PRINT "THE SELECTED SPACE, THEY, TOO, WILL BE": PRINT
2610 PRINT "INCORPORATED INTO THE EXISTING LANE.": PRINT
2620 GOSUB 2860
2630 PRINT
2640 PRINT "EACH NEW SQUARE ADJACENT TO A STAR ADDS": PRINT
2650 PRINT "$500 PER SHARE, AND EACH NEW OUTPOST": PRINT
2660 PRINT "ADDS $100 PER SHARE TO THE MARKET VALUE"
2670 PRINT
2680 PRINT "OF THE STOCK OF THAT SHIPPING COMPANY."
2690 PRINT
2700 PRINT "3. HE MAY ESTABLISH A NEW SHIPPING"
2710 PRINT
2720 PRINT "LANE- IF THERE ARE FOUR OR LESS EXISTING"
2730 PRINT "SHIPPING LANES EXTABLISHED, THE PLAYER": PRINT
2740 PRINT "MAY, GIVEN THE PROPER SPACE TO PLAY,": PRINT
2750 PRINT "ESTABLISH A NEW SHIPPING LANE. HE MAY": PRINT
2760 PRINT "DO THIS BY OCCUPYING A SPACE ADJACENT TO"
2770 GOSUB 2860: PRINT
2780 PRINT "A STAR OR ANOTHER UNATTACHED OUTPOST,": PRINT
2790 PRINT "BUT NOT ADJACENT TO AN EXISTING SHIPPING"
2800 PRINT "LANE, HE IS AUTOMATICALLY ISSUED FIVE": PRINT
2810 PRINT "SHARES IN THE NEW COMPANY AS A REWARD.": PRINT
2820 PRINT "AFTER EACH MOVE, A PLAYER MAY BUY SOME": PRINT
2830 PRINT "STOCK IN ONE TRADING COMPANY, BY TYPING": PRINT
2840 PRINT "THE COMPANY'S INITIAL AND A NUMBER FROM": PRINT
2850 PRINT "0 TO 9 (ASTERISK '*' TO BUY THE MAX).": PRINT
2860 VTAB 24: PRINT " PRESS ANY KEY TO CONTINUE. ";: GET X$: CALL -998: PRINT : HOME : RETURN